home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / Z-Misc Series / (k)zc.d64 / envelope.l < prev    next >
Text File  |  2007-03-01  |  3KB  |  142 lines
  1. 0010 // PROGRAM:
  2. 0020 // LIST "@:ENVELOPE.14.L"
  3. 0030 //
  4. 0040 //
  5. 0050 //
  6. 0060 // PROCEDURES TBV GELUID IN
  7. 0070 // CBM COMAL-80 VS 0.14
  8. 0080 // OVEREENKOMEND MET DIE IN VS 2.0
  9. 0090 //
  10. 0100 //
  11. 0110 PROC ADSR(STEM,A,D,S,R) 
  12. 0120   P:=5+(STEM-1)*7
  13. 0130   POKE SID+P,A*16+D
  14. 0140   POKE SID+P+1,S*16+R
  15. 0150 ENDPROC ADSR
  16. 0160 //
  17. 0170 PROC VOLUME(STERKTE) 
  18. 0180   POKE SID+24,STERKTE
  19. 0190 ENDPROC VOLUME
  20. 0200 //
  21. 0210 PROC GATE(STEM,JN) 
  22. 0220   P:=4+(STEM-1)*7
  23. 0230   W:=CONTROL(STEM)
  24. 0240   IF JN THEN
  25. 0250     W:=W-(W MOD 2)+1
  26. 0260   ELSE 
  27. 0270     W:=W-(W MOD 2)
  28. 0280   ENDIF 
  29. 0290   POKE SID+P,W
  30. 0300   CONTROL(STEM):=W
  31. 0310 ENDPROC GATE
  32. 0320 //
  33. 0330 PROC SOUNDTYPE(STEM,SRT) 
  34. 0340   P:=4+(STEM-1)*7
  35. 0350   CONTROL(STEM):=2^(SRT+3)
  36. 0360   POKE SID+P,CONTROL(STEM)
  37. 0370 ENDPROC SOUNDTYPE
  38. 0380 //
  39. 0390 PROC USE'SOUND 
  40. 0400   SID:=54272
  41. 0410   FOR P:=0 TO 24 DO POKE SID+P,0
  42. 0420   //
  43. 0430   DIM NOTEN$ OF 3*96, VALUE(0:95)
  44. 0440   DIM CONTROL(3)
  45. 0450   //
  46. 0460   FOR NT:=0 TO 95 DO
  47. 0470     READ NOTEN$(NT*3+1:NT*3+3)
  48. 0480   ENDFOR NT
  49. 0490   //
  50. 0500   NR:=-1
  51. 0510   FOR OKT:=0 TO 7 DO
  52. 0520     RESTORE BASIS
  53. 0530     FOR NT:=1 TO 12 DO
  54. 0540       NR:+1
  55. 0550       READ B
  56. 0560       W:=B/2^(7-OKT)
  57. 0570       VALUE(NR):=W
  58. 0580     ENDFOR NT
  59. 0590   ENDFOR OKT
  60. 0600   //
  61. 0610 NOTENRIJ:
  62. 0620   DATA "C0","C0#","D0","D0#","E0","F0","F0#","G0","G0#","A0","A0#","B0"
  63. 0630   DATA "C1","C1#","D1","D1#","E1","F1","F1#","G1","G1#","A1","A1#","B1"
  64. 0640   DATA "C2","C2#","D2","D2#","E2","F2","F2#","G2","G2#","A2","A2#","B2"
  65. 0650   DATA "C3","C3#","D3","D3#","E3","F3","F3#","G3","G3#","A3","A3#","B3"
  66. 0660   DATA "C4","C4#","D4","D4#","E4","F4","F4#","G4","G4#","A4","A4#","B4"
  67. 0670   DATA "C5","C5#","D5","D5#","E5","F5","F5#","G5","G5#","A5","A5#","B5"
  68. 0680   DATA "C6","C6#","D6","D6#","E6","F6","F6#","G6","G6#","A6","A6#","B6"
  69. 0690   DATA "C7","C7#","D7","D7#","E7","F7","F7#","G7","G7#","A7","A7#","B7"
  70. 0700 BASIS:
  71. 0710   DATA 34334,36376,38539,40830
  72. 0720   DATA 43258,45830,48556,51443
  73. 0730   DATA 54502,57743,61176,64814
  74. 0740   //
  75. 0750   INIT'VOICES
  76. 0760   //
  77. 0770 ENDPROC USE'SOUND
  78. 0780 //
  79. 0790 PROC NOTE(STEM,N$) 
  80. 0800   NR:=((N$ IN NOTEN$)-1)/3
  81. 0810   P:=(STEM-1)*7
  82. 0820   POKE SID+P,VALUE(NR) MOD 256
  83. 0830   POKE SID+P+1,VALUE(NR) DIV 256
  84. 0840 ENDPROC NOTE
  85. 0850 //
  86. 0860 PROC INIT'VOICES 
  87. 0870   ADSR(1,0,4,12,10)
  88. 0880   ADSR(2,10,8,10,9)
  89. 0890   ADSR(3,1,9,1,9)
  90. 0900   FOR STEM:=1 TO 3 DO
  91. 0910     PULSE(STEM,2048)
  92. 0920     SETFREQUENCY(STEM,0)
  93. 0930   ENDFOR STEM
  94. 0940   VOLUME(15)
  95. 0950   SOUNDTYPE(1,1)
  96. 0960   SOUNDTYPE(2,2)
  97. 0970   SOUNDTYPE(3,3)
  98. 0980 ENDPROC INIT'VOICES
  99. 0990 //
  100. 1000 PROC PULSE(STEM,F) 
  101. 1010   P:=2+(STEM-1)*7
  102. 1020   POKE SID+P,F MOD 256
  103. 1030   POKE SID+P+1,F DIV 256
  104. 1040 ENDPROC PULSE
  105. 1050 //
  106. 1060 PROC SETFREQUENCY(STEM,F) 
  107. 1070   P:=(STEM-1)*7
  108. 1080   POKE SID+P,F MOD 256
  109. 1090   POKE SID+P+1,F DIV 256
  110. 1100 ENDPROC SETFREQUENCY
  111. 1110 //
  112. 1120 PROC DISCARD 
  113. 1130   SID:=54272
  114. 1140   FOR P:=0 TO 24 DO POKE SID+P,0
  115. 1150 ENDPROC DISCARD
  116. 1160 
  117. 1170 USE GRAPHICS
  118. 1180 USE'SOUND
  119. 1190 GRAPHICSCREEN(0)
  120. 1200 VOLUME(10)
  121. 1210 SOUNDTYPE(3,1)
  122. 1220 ADSR(3,13,13,8,13)
  123. 1230 NOTE(3,"A4")
  124. 1240 GATE(3,0)
  125. 1250 WHILE ENV3<>0 DO NULL
  126. 1260 GATE(3,1)
  127. 1270 T:=0
  128. 1280 WHILE T<600 DO
  129. 1290   T:+1
  130. 1300   DRAWTO(T/5,ENV3/256*199)
  131. 1310 ENDWHILE 
  132. 1320 GATE(3,0)
  133. 1330 WHILE T/5<320 DO
  134. 1340   T:+1
  135. 1350   DRAWTO(T/5,ENV3/256*199)
  136. 1360 ENDWHILE 
  137. 1370 WHILE KEY$=CHR$(0) DO NULL
  138. 1380 DISCARD
  139. 1390 FUNC ENV3 
  140. 1400   RETURN PEEK(SID+28)
  141. 1410 ENDFUNC ENV3
  142.